home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / fielddh.exe / COLOR_AP.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-30  |  12KB  |  317 lines
  1. {*--------------------------------------------------------------------------*}
  2. {*   To Use the COLOR features (Buttons, etc) you must:                     *}
  3. {*     0: Have your application be a PCOLOR_APP from this unit!!!!          *}
  4. {*     1: Have your DIALOG be a PCOLOR_DIALOG from this unit!               *}
  5. {*     2: Pascal-Code the PCOLOR_BUTTONS/PCOLOR_STATICTEXT exactly          *}
  6. {*        the same as if they were 'normal' TButton/TStaticText.            *}
  7. {*     3: The FIELDS unit knows about these COLOR objects.                  *}
  8. {*--------------------------------------------------------------------------*}
  9. UNIT Color_App;    {Colored Application Buttons/TEXT!!}
  10.  
  11.  
  12. INTERFACE
  13. USES App,       {TVISION, modified version to handle COLOR buttons!}
  14.      Dialogs,   {TVISION, button}
  15.      Views,     {TVision, titlestr}
  16.      Objects;   {TVision, misc}
  17.  
  18. CONST
  19.   Button_Color_Default :byte = 0;     {green}
  20.   Button_Black         :byte = 1;
  21.   Button_Dk_Blue       :byte = 2;
  22.   Button_Green         :byte = 3;
  23.   Button_Cyan          :byte = 4;
  24.   Button_Red           :byte = 5;
  25.   Button_Purple        :byte = 6;
  26.   Button_Brown         :byte = 7;
  27.   Button_Grey          :byte = 8;
  28.  
  29.   Button_Dk_Grey       :byte = 9;
  30.   Button_Lt_Blue       :byte = 10;
  31.   Button_Lt_Green      :byte = 11;
  32.   Button_Lt_Cyan       :byte = 12;
  33.   Button_Lt_Red        :byte = 13;
  34.   Button_Lt_Purple     :byte = 14;
  35.   Button_Yellow        :byte = 15;
  36.   Button_White         :byte = 16;
  37.  
  38. TYPE
  39.   PColor_InputLine = ^Color_Inputline;
  40.   Color_InputLine = OBJECT(TInputLine)
  41.     constructor Init (var Bounds: TRect; AMaxLen: Integer;
  42.                       Button_Color_ID : byte);   {new parameter!}
  43.     function GetPalette : PPalette; virtual;     {MUST Override!}
  44.   private
  45.     Color         : word;
  46.   end; {color_inputline}
  47.  
  48.  
  49.   PColor_Button = ^Color_Button;
  50.   Color_Button = object(DIALOGS.TButton)
  51.     constructor Init (var Bounds      : OBJECTS.TRect;
  52.                       ATitle          : VIEWS.TTitleStr;
  53.                       ACommand        : Word;
  54.                       AFlags          : Byte;
  55.                       Button_Color_ID : byte);   {new parameter!}
  56.     function GetPalette : PPalette; virtual;     {MUST Override!}
  57.     procedure New_Color (Button_Color_ID : Byte);
  58.     function Get_Color : integer;
  59.     procedure Hide_Shadow;
  60.   private
  61.     Color         : word;
  62.     Shadow_Hidden : boolean;
  63.   end; {Color_Button}
  64.  
  65.   PColor_StaticText = ^Color_StaticText;
  66.   Color_StaticText = object(DIALOGS.TStaticText)
  67.     constructor Init (var Bounds      : OBJECTS.TRect;
  68.                       AText           : string;
  69.                       Button_Color_ID : byte);   {new parameter!}
  70.     function GetPalette : PPalette; virtual;     {MUST Override!}
  71.   private
  72.     Color         : word;
  73.   end; {Color_StaticText}
  74.  
  75.   PColor_Dialog = ^Color_Dialog;
  76.   Color_Dialog = object(TDialog)
  77.     constructor init (var bounds: TRect; ATitle: TTitleStr);
  78.     function GetPalette : PPalette; virtual;     {MUST Override!}
  79.   end; {Color_Dialog}
  80.  
  81.  
  82.   PColor_Application = ^Color_Application;
  83.                  {this elimates need to tweak APP.pas}
  84.   Color_Application = object(TApplication)
  85.     function GetPalette : PPalette; virtual;     {MUST Override!}
  86.   end; {Color_Application}
  87.  
  88.   {*-----------------------------------------------------------*}
  89.   {* If you want blinking, you must call SetBlink(TRUE)        *}
  90.   {* after a color dialog                                      *}
  91.   {*-----------------------------------------------------------*}
  92.   procedure SetBlink(State: Boolean);
  93.  
  94.  
  95. {*************************************************************************}
  96. {*************************************************************************}
  97. {*************************************************************************}
  98. IMPLEMENTATION
  99.  
  100.  
  101. {*************************************************************************}
  102. procedure SetBlink(State: Boolean); assembler; {by steve shafer}
  103. asm
  104.   mov ax,$1003
  105.   mov bl,state
  106.   push bp
  107.   int $10
  108.   pop bp
  109. end; {setblink}
  110.  
  111.  
  112. {**************************************************************************}
  113. constructor Color_InputLine.Init;
  114. begin
  115.   TInputLine.Init (Bounds, AMaxLen);
  116.   Color := Button_Color_ID;
  117. end; {init}
  118.  
  119. {**************************************************************************}
  120. function Color_InputLine.GetPalette : PPalette;
  121. const
  122.   D_Palette : string[4] = '';
  123. begin
  124.   {*-----------------------------------------------------------------------*}
  125.   {* Must be VAR rather than const to RESET to default each time!          *}
  126.   {*   (changes to a const version of D_Palette is REMEMBERED!)            *}
  127.   {*-----------------------------------------------------------------------*}
  128.         {#19#19#20#21;  => TVision default colors for TInputLine}
  129.   D_Palette := TInputLine.GetPalette^;
  130.  
  131.   IF ((Color > 0) and (Color < 17)) THEN
  132.     BEGIN
  133.       D_Palette[1] := CHAR(30+(Color*3));     {normal}
  134.       D_Palette[2] := D_Palette[1];
  135.       D_Palette[3] := CHAR(30+(Color*3)+1);   {selected}
  136.     END;
  137.  
  138.   GetPalette := @D_Palette;
  139. end; {getpalette}
  140.  
  141. {**************************************************************************}
  142. constructor Color_Button.Init;
  143. begin
  144.   TButton.Init (Bounds, ATitle, ACommand, AFlags);
  145.   Color := Button_Color_ID;
  146.   Shadow_Hidden := FALSE;
  147. end; {init}
  148.  
  149. {**************************************************************************}
  150. procedure Color_Button.New_Color;
  151. begin
  152.   Color := Button_Color_ID;
  153.   Draw;  {display the change}
  154. end; {new_color}
  155.  
  156. {**************************************************************************}
  157. function Color_Button.Get_Color : integer;
  158. begin
  159.   Get_Color := Color;
  160. end; {get_color}
  161.  
  162. {**************************************************************************}
  163. procedure Color_Button.Hide_Shadow;
  164. begin
  165.   Shadow_Hidden := TRUE;
  166.   Draw;  {display the change}
  167. end; {hide_shadow}
  168.  
  169. {**************************************************************************}
  170. function Color_Button.GetPalette : PPalette;
  171.    {*  NOTE: Colors assumes use of COLOR Monitor!!!!  *}
  172.  {  bckgrnd / letters
  173.    49=NO SHADOW       (maybe want to instead use char[1]?)
  174.   0 - black         4 - red           8 - dark gray     C - light red
  175.   1 - blue          5 - magenta       9 - light blue    D - light magenta
  176.   2 - green         6 - brown         A - light green   E - yellow
  177.   3 - cyan          7 - light gray    B - light cyan    F - white
  178.  }                                       {see pg 107 on methodology}
  179. const
  180.   D_Palette : string[8] = '';
  181. begin
  182.   {*-----------------------------------------------------------------------*}
  183.   {* Must be VAR rather than const to RESET to default each time!          *}
  184.   {*   (changes to a const version of D_Palette is REMEMBERED!)            *}
  185.   {*-----------------------------------------------------------------------*}
  186.      {#10#11#12#13#14#14#14#15;  => TVISION default colors for TButton}
  187.   D_Palette := TButton.GetPalette^;
  188.  
  189.   IF ((Color > 0) and (Color < 17)) THEN
  190.     BEGIN
  191.       D_Palette[1] := CHAR(30+(Color*3));     {normal}
  192.       D_Palette[2] := D_Palette[1];           {normal for highlights}
  193.       D_Palette[3] := CHAR(30+(Color*3)+1);   {selected button}
  194.  
  195.       D_Palette[5] := CHAR(30+(Color*3)+2);   {shortcut}
  196.       D_Palette[6] := D_Palette[5];
  197.       D_Palette[7] := D_Palette[6];
  198.     END;
  199.   IF (Shadow_Hidden)
  200.     THEN D_Palette[8] := #81;  {set to EXTENDED set (background)}
  201.  
  202.   GetPalette := @D_Palette;
  203. end; {getpalette}
  204.  
  205. {**************************************************************************}
  206. constructor Color_StaticText.Init;
  207. begin
  208.   TStaticText.Init (Bounds, AText);
  209.   Color := Button_Color_ID;
  210. end; {init}
  211.  
  212. {**************************************************************************}
  213. function Color_StaticText.GetPalette : PPalette;
  214. const
  215.   D_Palette : string[1] = '';
  216. begin
  217.   {*-----------------------------------------------------------------------*}
  218.   {* Must be VAR rather than const to RESET to default each time!          *}
  219.   {*   (changes t